home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / internet / source / ping.rpg < prev    next >
Encoding:
Text File  |  1995-04-17  |  8.0 KB  |  212 lines
  1.      H
  2.      FPINGICF CF  E                    WORKSTN                        UC
  3.      F                                              KINFDS ICFDS
  4.      F                                              KINFSR ICFSUB
  5.      F                                              KNUM        1
  6.      E* ---------------------------------------------------------------
  7.      E* ARRAYS: AC=COMMANDS, AX=COMMAND OVERLAY
  8.      E*
  9.      E                    AC      1  26 74
  10.      E                    AX        130  1
  11.      I* ---------------------------------------------------------------
  12.      I* ICF FEED BACK AREA
  13.      I*
  14.      IICFDS       DS
  15.      I                                     *ROUTINE LOC
  16.      I                                     *STATUS  ERR
  17.      I                                       38  45 ICFFMT
  18.      I                                      273 282 ICFDEV
  19.      I                                      401 404 ICFCOD
  20.      I                                      401 402 ICFMAJ
  21.      I                                      403 404 ICFMIN
  22.      I* ---------------------------------------------------------------
  23.      I* PROGRAM STATUS DATA STRUCTURE
  24.      I*
  25.      IPDDS       SDS
  26.      I                                        1  10 PDSNAM
  27.      I                                       11  150PDSSTS
  28.      I                                       40  42 PDSTYP
  29.      I                                       43  46 PDSNUM
  30.      I                                       40  46 PDSMSG
  31.      I                                       81  90 PDSLIB
  32.      I                                       91 170 PDSTXT
  33.      I* ---------------------------------------------------------------
  34.      I* OVERLAY FOR COMMAND WORK FIELD
  35.      I*
  36.      IQCXDS       DS
  37.      I                                        1 133 QCXFLD
  38.      I                                        4 133 QCXCMD
  39.      I                                        4 133 AX
  40.      I* ---------------------------------------------------------------
  41.      I* UPPER AND LOWER CASE LETTERS
  42.      I*
  43.      I              'ABCDEFGHIJKLMNOPQRST-C         CAP
  44.      I              'UVWXYZ'
  45.      I              'abcdefghijklmnopqrst-C         LOWER
  46.      I              'uvwxyz'
  47.      C* ---------------------------------------------------------------
  48.      C* PARAMETER LIST
  49.      C*
  50.      C           *ENTRY    PLIST
  51.      C                     PARM           PGMDEV 10
  52.      C*
  53.      C*****************************************************************
  54.      C* MAIN EXECUTION LOOP
  55.      C*
  56.      C           'FOREVER' DOWEQ'FOREVER'
  57.      C* ---------------------------------------------------------------
  58.      C* READ RECORD
  59.      C*
  60.      C                     READ ICFIN                  0102
  61.      C* ---------------------------------------------------------------
  62.      C* WAS DATA RECEIVED IF SO THEN
  63.      C* MOVE TO STORAGE FIELD
  64.      C*
  65.      C           ICFMAJ    IFEQ '00'
  66.      C                     MOVE IPING     XPING   1
  67.      C                     ENDIF
  68.      C* ---------------------------------------------------------------
  69.      C* WAS A CONFIRMATION REQUESTED
  70.      C*
  71.      C           ICFMIN    IFEQ '15'
  72.      C                     WRITEICFRCF                 01
  73.      C                     ENDIF
  74.      C           ICFMIN    IFEQ '1C'
  75.      C                     WRITEICFRCF                 01
  76.      C                     LEAVE
  77.      C                     ENDIF
  78.      C* ---------------------------------------------------------------
  79.      C* TRANSLATE AND WRITE RECORD BACK OUT
  80.      C* IF NOTHING BUT DATA RECORD CAME THRU
  81.      C*
  82.      C           ICFMIN    IFEQ '00'
  83.      C           LOWER:CAP XLATEXPING     OPING
  84.      C                     WRITEICFOUT                 01
  85.      C                     ENDIF
  86.      C* ---------------------------------------------------------------
  87.      C* LEAVE LOOP ON THESE STATUS CODES
  88.      C*
  89.      C           ICFMIN    IFEQ '08'                       DETACH
  90.      C           ICFMAJ    OREQ '80'
  91.      C           ICFMAJ    OREQ '81'
  92.      C           ICFMAJ    OREQ '82'
  93.      C           ICFMAJ    OREQ '83'
  94.      C                     LEAVE
  95.      C                     ENDIF
  96.      C* ---------------------------------------------------------------
  97.      C* END OF MAIN EXECUTION LOOP
  98.      C*
  99.      C                     ENDDO
  100.      C*
  101.      C*****************************************************************
  102.      C*****************************************************************
  103.      C* END OF JOB
  104.      C*
  105.      C           ENDALL    TAG
  106.      C                     EXSR ENDPGM
  107.      C*
  108.      C*****************************************************************
  109.      C*****************************************************************
  110.      C* SUBROUTINES
  111.      C*****************************************************************
  112.      C* ICF FILE UNIVERSAL ERROR HANDLER
  113.      C*
  114.      C           ICFSUB    BEGSR
  115.      C           ERR       IFEQ 01285
  116.      C                     MOVE *BLANKS   ICFRTN  6
  117.      C                     ELSE
  118.      C                     MOVE '*CANCL'  ICFRTN
  119.      C                     ENDIF
  120.      C           ICFEND    ENDSRICFRTN
  121.      C*
  122.      C*****************************************************************
  123.      C* EXECUTE COMMAND USING QCMDEXC
  124.      C*
  125.      C           QCXSUB    BEGSR
  126.      C                     CALL 'QCMDEXC'              77
  127.      C                     PARM           QCXCMD
  128.      C                     PARM 130.0     QCXLEN 155
  129.      C                     ENDSR
  130.      C*
  131.      C*****************************************************************
  132.      C* PERFORM SETUP REQUIREMENTS
  133.      C*
  134.      C           *INZSR    BEGSR
  135.      C* ---------------------------------------------------------------
  136.      C* ADD PROGRAM LIBRARY TO LIBRARY LIST
  137.      C*
  138.      C                     MOVE *BLANKS   QCXFLD
  139.      C                     MOVELAC,25     QCXFLD
  140.      C                     MOVEAPDSLIB    AX,10
  141.      C                     EXSR QCXSUB
  142.      C* ---------------------------------------------------------------
  143.      C* CHANGE OUTPUT QUEUE TO USER'S
  144.      C*
  145.      C                     MOVE *BLANKS   QCXFLD
  146.      C                     MOVELAC,24     QCXFLD
  147.      C                     EXSR QCXSUB
  148.      C* ---------------------------------------------------------------
  149.      C* TURN TRACE ON
  150.      C*
  151.      C                     MOVE *BLANKS   QCXFLD
  152.      C                     MOVELAC,23     QCXFLD
  153.      C                     EXSR QCXSUB
  154.      C* ---------------------------------------------------------------
  155.      C* OPEN AND ACQUIRE FILE
  156.      C*
  157.      C                     OPEN PINGICF
  158.      C           PGMDEV    ACQ  PINGICF
  159.      C                     ENDSR
  160.      C*
  161.      C*****************************************************************
  162.      C* PERFORM END PROGRAM REQUIREMENTS
  163.      C*
  164.      C           ENDPGM    BEGSR
  165.      C* ---------------------------------------------------------------
  166.      C* RELEASE ICF FILE
  167.      C*
  168.      C           PGMDEV    REL  PINGICF
  169.      C* ---------------------------------------------------------------
  170.      C* CLOSE ALL FILES
  171.      C*
  172.      C                     CLOSE*ALL
  173.      C* ---------------------------------------------------------------
  174.      C* TURN TRACE OFF
  175.      C*
  176.      C                     MOVE *BLANKS   QCXFLD
  177.      C                     MOVELAC,22     QCXFLD
  178.      C                     EXSR QCXSUB
  179.      C* ---------------------------------------------------------------
  180.      C* END PROGRAM
  181.      C*
  182.      C                     SETON                         LR
  183.      C                     RETRN
  184.      C                     ENDSR
  185. ** COMMANDS FOR QCMDEXC
  186. 01 OVRPRTF FILE(QPDSPSTS) TOFILE(QPDSPSTS) HOLD(*YES)
  187. 02 WRKSYSSTS OUTPUT(*PRINT) RESET(*NO)
  188. 03 DLTOVR FILE(QPDSPSTS)
  189. 04 CPYSPLF FILE(QPDSPSTS) TOFILE(GENSPLF) SPLNBR(*LAST)
  190. 05 DLTSPLF FILE(QPDSPSTS) SPLNBR(*LAST)
  191. 06
  192. 07
  193. 08
  194. 09
  195. 10
  196. 11
  197. 12
  198. 13
  199. 14
  200. 15
  201. 16
  202. 17
  203. 18
  204. 19 OVRMSGF MSGF(QUSERMSG) TOMSGF(QCPFMSG)
  205. 20 DLTOVR FILE(*ALL)
  206. 21 OVRDBF
  207. 22 TRCICF SET(*OFF)
  208. 23 TRCICF SET(*ON) DTALEN(1)
  209. 24 CHGJOB OUTQ(*USRPRF)
  210. 25 ADDLIBLE
  211. GENESIS SOFTWARE, INC.
  212.